home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbconsl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  22.5 KB  |  692 lines
  1. (*===========================================================================*)
  2. (* Console I/O -- Overlay                                                    *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. {$UNDEF   SEMABUG}
  12. {$UNDEF   NODEBUG}
  13. {$UNDEF   WINBUG}
  14. {$DEFINE  PORTBUG}
  15. {$UNDEF   DUMP_FREE}
  16. {$UNDEF   DUMP_SEARCH}
  17.  
  18. UNIT BBCONSL;
  19.  
  20. INTERFACE
  21.  
  22. VAR
  23.  
  24.   operator_line_c  : BOOLEAN;
  25.   op_sw            : BOOLEAN;
  26.   opr_line_done    : BOOLEAN;
  27.   opr_window_open  : BOOLEAN;
  28.  
  29. PROCEDURE operator_line;
  30. PROCEDURE close_operator_session;
  31. PROCEDURE operator_init_session;
  32.  
  33. IMPLEMENTATION
  34.  
  35. USES
  36.   CRT,
  37.   bbconio,
  38.   bbdummy,
  39.   bbdump,
  40.   bbmem,
  41.   bbmisci,
  42.   bbsdata,
  43.   bbsema2,
  44.   bbsess,
  45.   bbstr,
  46.   bbtask,
  47.   bbuf,
  48.   bbwin;
  49.  
  50. {$I EXTKEY.PAS}
  51.  
  52. CONST
  53.   line_buffer_max = 10;
  54.   line_max        = 79;
  55.  
  56. VAR
  57.   current_buffer   : BYTE;
  58.   insert_buffer    : BYTE;
  59.   high_buffer      : BYTE;
  60.   line_buffer      : ARRAY[1..line_buffer_max] OF STRING[line_max];
  61.   operator_insert  : BOOLEAN;
  62.   operator_line_in : ^STRING;
  63.   this_key         : CHAR;
  64.  
  65. PROCEDURE do_key;       FORWARD;
  66. PROCEDURE function_key; FORWARD;
  67.  
  68. (*===========================================================================*)
  69. (* Get a line from the operator -- wait for it!                              *)
  70. (*===========================================================================*)
  71.  
  72. PROCEDURE operator_line;
  73.  
  74.   BEGIN;
  75.  
  76.     (*-----------------------------------------------------------------------*)
  77.     (* Initialize                                                            *)
  78.     (*-----------------------------------------------------------------------*)
  79.  
  80.     operator_line_in  := @active_tcb^.i_data.str_data;
  81.  
  82.     opr_line_done     := FALSE;
  83.     operator_line_c   := FALSE;
  84.     operator_line_in^ := '';
  85.  
  86.     (*-----------------------------------------------------------------------*)
  87.     (* Call the non-overlayed routine "operator_io_loop" to wait for a       *)
  88.     (* key stroke from the operator.  We fall out of the loop if the end     *)
  89.     (* of the line is reached                                                *)
  90.     (*-----------------------------------------------------------------------*)
  91.  
  92.     WHILE NOT operator_io_loop DO
  93.       do_key;
  94.  
  95.     (*-----------------------------------------------------------------------*)
  96.     (* Special key!                                                          *)
  97.     (*-----------------------------------------------------------------------*)
  98.  
  99.     IF operator_line_c THEN
  100.       BEGIN;
  101.         operator_line_in^ := '';
  102.         active_tcb^.i_data.long_length := 0;
  103.         EXIT;
  104.       END
  105.     ELSE
  106.       active_tcb^.i_data.long_length := LENGTH(operator_line_in^);
  107.  
  108.     (*-----------------------------------------------------------------------*)
  109.     (* Open operator window if not already open                              *)
  110.     (*-----------------------------------------------------------------------*)
  111.  
  112.     IF NOT opr_window_open THEN
  113.       BEGIN;
  114.  
  115.         window_activate(window_operator);
  116.         opr_window_open := TRUE;
  117.  
  118.       END;
  119.  
  120.   END;
  121.  
  122. (*===========================================================================*)
  123. (* Handle operator's key stroke                                              *)
  124. (*===========================================================================*)
  125.  
  126. PROCEDURE do_key;
  127.  
  128.   VAR
  129.     i : BYTE;
  130.  
  131.   BEGIN;
  132.  
  133.     (*-----------------------------------------------------------------------*)
  134.     (* Read the key                                                          *)
  135.     (*-----------------------------------------------------------------------*)
  136.  
  137.     this_key := READKEY;
  138.  
  139.     (*-----------------------------------------------------------------------*)
  140.     (* Special key!                                                          *)
  141.     (*-----------------------------------------------------------------------*)
  142.  
  143.     IF this_key = CHR(0) THEN
  144.       BEGIN;
  145.         this_key := READKEY;
  146.         function_key;
  147.         EXIT;
  148.       END;
  149.  
  150.     (*-----------------------------------------------------------------------*)
  151.     (* Everything else                                                       *)
  152.     (*-----------------------------------------------------------------------*)
  153.  
  154.     window_select(window_reset);
  155.  
  156.     CASE this_key OF
  157.  
  158.       (*-----------------------------------------------------------------------*)
  159.       (* CR -- Line done.  Clear it off the screen                             *)
  160.       (*-----------------------------------------------------------------------*)
  161.  
  162.       cr : BEGIN;
  163.  
  164.              IF LENGTH(operator_line_in^) = 0 THEN
  165.                operator_line_in^ := ' '
  166.              ELSE
  167.                BEGIN;
  168.                  IF high_buffer < line_buffer_max THEN
  169.                    BEGIN;
  170.                      INC(high_buffer);
  171.                      insert_buffer := high_buffer;
  172.                    END
  173.                  ELSE
  174.                    BEGIN;
  175.                      INC(insert_buffer);
  176.                      IF insert_buffer > line_buffer_max THEN
  177.                        insert_buffer := 1;
  178.                    END;
  179.                  line_buffer[insert_buffer] := operator_line_in^;
  180.  
  181.                  current_buffer := insert_buffer;
  182.  
  183.                END;
  184.  
  185.              operator_line_in^ := operator_line_in^ + cr;
  186.  
  187.              opr_line_done := TRUE;
  188.  
  189.              i := window_cursor_update(1);
  190.              window_erase_eol(window_reset);
  191.  
  192.              EXIT;
  193.            END;
  194.  
  195.       (*---------------------------------------------------------------------*)
  196.       (* Backspace                                                           *)
  197.       (*---------------------------------------------------------------------*)
  198.  
  199.       bs: BEGIN;
  200.  
  201.             i := window_cursor_update(0);
  202.  
  203.             IF i > 1 THEN
  204.               BEGIN;
  205.  
  206.                 IF i = 2 THEN
  207.                   operator_line_in^ := substr(operator_line_in^, 2, 0)
  208.                 ELSE
  209.                   IF i > LENGTH(operator_line_in^) THEN
  210.                     operator_line_in^ := substr(operator_line_in^, 1, i-2)
  211.                   ELSE
  212.                     operator_line_in^ := substr(operator_line_in^, 1, i-2) +
  213.                                          substr(operator_line_in^, i, 0);
  214.  
  215.                 color(opt_block.status_color);
  216.  
  217.                 i := window_cursor_update(i-1);
  218.  
  219.                 CLREOL;
  220.  
  221.                 IF i <= LENGTH(operator_line_in^) THEN
  222.                   WRITE(substr(operator_line_in^, i-1, 0));
  223.  
  224.                 i := window_cursor_update(i-1);
  225.  
  226.               END;
  227.  
  228.           END;
  229.  
  230.       (*---------------------------------------------------------------------*)
  231.       (* Anything else -- Just print it.                                     *)
  232.       (*---------------------------------------------------------------------*)
  233.  
  234.       ELSE
  235.         BEGIN;
  236.  
  237.           IF LENGTH(operator_line_in^) < line_max THEN
  238.             BEGIN;
  239.               COLOR(opt_block.status_color);
  240.               i := window_cursor_update(0);
  241.               IF i > LENGTH(operator_line_in^) THEN
  242.                 BEGIN;
  243.                   WRITE(this_key);
  244.                   operator_line_in^ := operator_line_in^ + this_key;
  245.                 END
  246.               ELSE
  247.                 BEGIN;
  248.                   IF operator_insert THEN
  249.                     BEGIN;
  250.                       IF i > 1 THEN
  251.                         operator_line_in^ := substr(operator_line_in^, 1, i-1)
  252.                                            + this_key
  253.                                            + substr(operator_line_in^, i, 0)
  254.                       ELSE
  255.                         operator_line_in^ := this_key + operator_line_in^;
  256.                     END
  257.                   ELSE
  258.                     operator_line_in^[i] := this_key;
  259.                   WRITE(substr(operator_line_in^, i, 0));
  260.                   i := window_cursor_update(i+1);
  261.                 END;
  262.             END
  263.           ELSE
  264.             BEGIN;
  265.               SOUND(440);
  266.               DELAY(100);
  267.               NOSOUND;
  268.             END;
  269.         END;
  270.  
  271.     END;
  272.  
  273.   END;
  274.  
  275. (*===========================================================================*)
  276. (* Handle a function key or an extended key                                  *)
  277. (*===========================================================================*)
  278.  
  279. PROCEDURE function_key;
  280.  
  281.   VAR
  282.     b : BOOLEAN;
  283.     i : INTEGER;
  284.     j : INTEGER;
  285.  
  286. {$IFDEF NODEBUG}
  287.     bug_port : port_block_ptr;
  288.     bug_tcb  : tcb_ptr;
  289.     bug_chn  : str_m_chain;
  290. {$ENDIF}
  291.  
  292.   BEGIN;
  293.  
  294.     CASE this_key OF
  295.  
  296.       (*---------------------------------------------------------------------*)
  297.       (* Right/Left Arrows : Move cursor                                     *)
  298.       (*---------------------------------------------------------------------*)
  299.  
  300.       ekey_left_arrow,
  301.       ekey_right_arrow:
  302.                  BEGIN;
  303.  
  304.                    i := window_cursor_update(0);
  305.                    IF this_key = ekey_right_arrow THEN
  306.                      INC(i)
  307.                    ELSE
  308.                      DEC(i);
  309.                    IF (i > 0) AND (i <= (LENGTH(operator_line_in^) + 1)) THEN
  310.                      i := window_cursor_update(i);
  311.  
  312.                  END;
  313.  
  314.       (*---------------------------------------------------------------------*)
  315.       (* Delete : Delete character above the cursor;                         *)
  316.       (*---------------------------------------------------------------------*)
  317.  
  318.       ekey_delete:
  319.                  BEGIN;
  320.  
  321.                    i := window_cursor_update(0);
  322.                    IF (i <= LENGTH(operator_line_in^)) THEN
  323.                      BEGIN;
  324.                        IF i > 1 THEN
  325.                          operator_line_in^ := substr(operator_line_in^, 1, i-1)
  326.                                            +  substr(operator_line_in^, i+1, 0)
  327.                        ELSE
  328.                          operator_line_in^ := substr(operator_line_in^, 2, 0);
  329.                        color(opt_block.status_color);
  330.                        CLREOL;
  331.                        WRITE(substr(operator_line_in^, i, 0));
  332.                        i := window_cursor_update(i);
  333.                      END;
  334.  
  335.                  END;
  336.  
  337.       (*---------------------------------------------------------------------*)
  338.       (* Insert : Flip cursor                                                *)
  339.       (*---------------------------------------------------------------------*)
  340.  
  341.       ekey_insert:
  342.                  BEGIN;
  343.  
  344.                    i := window_cursor_update(0);
  345.                    color(opt_block.status_color);
  346.                    operator_insert := NOT operator_insert;
  347.                    window_cursor_size(operator_insert);
  348.  
  349.                  END;
  350.  
  351.       (*---------------------------------------------------------------------*)
  352.       (* F1:  Move cursor to front of line                                   *)
  353.       (*---------------------------------------------------------------------*)
  354.  
  355.       ekey_f1:
  356.                    i := window_cursor_update(1);
  357.  
  358.       (*---------------------------------------------------------------------*)
  359.       (* F2: Erase to end of line                                            *)
  360.       (*---------------------------------------------------------------------*)
  361.  
  362.       ekey_f2  : BEGIN;
  363.  
  364.                    i := window_cursor_update(0);
  365.                    color(opt_block.status_color);
  366.  
  367.                    IF i > 1 THEN
  368.                      operator_line_in^ := substr(operator_line_in^, 1, i-1)
  369.                    ELSE
  370.                      operator_line_in^ := '';
  371.  
  372.                    j := i;
  373.                    WHILE j <= line_max DO
  374.                      BEGIN;
  375.                        INC(j);
  376.                        WRITE(' ');
  377.                      END;
  378.  
  379.                    i := window_cursor_update(i);
  380.  
  381.                  END;
  382.  
  383.       (*---------------------------------------------------------------------*)
  384.       (* F3: Close operator window and any sub task                          *)
  385.       (*---------------------------------------------------------------------*)
  386.  
  387.       ekey_f3  : close_operator_session;
  388.  
  389.       (*---------------------------------------------------------------------*)
  390.       (* F4:  Clear window                                                   *)
  391.       (*---------------------------------------------------------------------*)
  392.  
  393.       ekey_f4 : BEGIN;
  394.  
  395.                   IF opr_window_open THEN
  396.                     i := window_operator
  397.                   ELSE
  398.                     i := who_is_in_window(window_bottom_screen);
  399.  
  400.                   window_select(i);
  401.                   window_clear(i);
  402.  
  403.                 END;
  404.  
  405.       (*---------------------------------------------------------------------*)
  406.       (* F5:  Swap windows                                                   *)
  407.       (*---------------------------------------------------------------------*)
  408.  
  409.       ekey_f5 : window_swap;
  410.  
  411.       (*---------------------------------------------------------------------*)
  412.       (* F7: Kill operator sub task                                          *)
  413.       (*---------------------------------------------------------------------*)
  414.  
  415.       ekey_f7 : BEGIN;
  416.                   operator_line_c := TRUE;
  417.                   op_busy := FALSE;
  418.                 END;
  419.  
  420.       (*---------------------------------------------------------------------*)
  421.       (* F9, F10 : Retrieve                                                  *)
  422.       (*---------------------------------------------------------------------*)
  423.  
  424.       ekey_f9,
  425.       ekey_f10 : BEGIN;
  426.  
  427.                    IF high_buffer < 1 THEN
  428.                      EXIT;
  429.  
  430.                    IF this_key = ekey_f9 THEN
  431.                      BEGIN;
  432.                        INC(current_buffer);
  433.                        IF current_buffer > high_buffer THEN
  434.                          current_buffer := 1;
  435.                      END;
  436.  
  437.                    operator_line_in^ := line_buffer[current_buffer];
  438.                    j                 := ORD(line_buffer[current_buffer, 0]);
  439.  
  440.                    color(opt_block.status_color);
  441.  
  442.                    i := window_cursor_update(1);
  443.                    WRITE(operator_line_in^);
  444.  
  445.                    CLREOL;
  446.  
  447.                    i := window_cursor_update(j+1);
  448.  
  449.                    IF this_key = ekey_f10 THEN
  450.                      BEGIN;
  451.                        DEC(current_buffer);
  452.                        IF current_buffer < 1 THEN
  453.                          current_buffer := high_buffer;
  454.                      END;
  455.  
  456.                  END;
  457.  
  458.       (*---------------------------------------------------------------------*)
  459.       (* UP/DOWN ARROW, HOME, END; Scroll bottom window                      *)
  460.       (*---------------------------------------------------------------------*)
  461.  
  462.       ekey_up_arrow, ekey_down_arrow, ekey_home, ekey_end:
  463.                  BEGIN;
  464.  
  465.                    IF opr_window_open THEN
  466.                      window_select(window_operator)
  467.                    ELSE
  468.                      BEGIN;
  469.                        i := who_is_in_window(window_bottom_screen);
  470.                        window_select(i);
  471.                      END;
  472.  
  473.                    CASE this_key OF
  474.                      ekey_up_arrow, ekey_down_arrow:
  475.                        scr_window(this_key = ekey_up_arrow, 1);
  476.                      ekey_home, ekey_end:
  477.                        scr_window(this_key = ekey_home,  9999);
  478.                    END;
  479.  
  480.                  END;
  481.  
  482.       (*---------------------------------------------------------------------*)
  483.       (* PG-UP, PG-DOWN, CTL-PG-UP, CTL-PG-DOWN: Scroll top window           *)
  484.       (*---------------------------------------------------------------------*)
  485.  
  486.       ekey_page_down, ekey_page_up,
  487.       ekey_control_page_down, ekey_control_page_up:
  488.                  BEGIN;
  489.  
  490.                    i := who_is_in_window(window_top_screen);
  491.                    window_select(i);
  492.  
  493.                    CASE this_key OF
  494.                      ekey_page_down, ekey_page_up:
  495.                        scr_window(this_key = ekey_page_up, 1);
  496.                      ekey_control_page_down, ekey_control_page_up:
  497.                        scr_window(this_key = ekey_control_page_up,  9999);
  498.                    END;
  499.  
  500.                  END;
  501.  
  502.       (*---------------------------------------------------------------------*)
  503.       (* ALT-X: Exit immediately                                             *)
  504.       (*---------------------------------------------------------------------*)
  505.  
  506.       ekey_x : shutdown_bbs;
  507.  
  508.       (*---------------------------------------------------------------------*)
  509.       (* ALT-A: Abort printer                                                *)
  510.       (*---------------------------------------------------------------------*)
  511.  
  512.       ekey_a : kill_printer := TRUE;
  513.  
  514.       (*---------------------------------------------------------------------*)
  515.       (* Semaphore debugger -- ALT-O                                         *)
  516.       (*---------------------------------------------------------------------*)
  517.  
  518. {$IFDEF SEMABUG}
  519.  
  520.       #$18:  BEGIN;
  521.               dump_reason('ALT-O Semaphore bug');
  522.               dump_semaphores;
  523.             END;
  524.  
  525. {$ENDIF}
  526.  
  527.       (*---------------------------------------------------------------------*)
  528.       (* Free list debugger -- ALT-I                                         *)
  529.       (*---------------------------------------------------------------------*)
  530.  
  531. {$IFDEF DUMP_FREE}
  532.  
  533.       #$17: BEGIN;
  534.               dump_reason('ALT-N processing dump free');
  535.               dump_all_thread;
  536.             END;
  537.  
  538. {$ENDIF}
  539.  
  540.       (*---------------------------------------------------------------------*)
  541.       (* Free list debugger -- ALT-O                                         *)
  542.       (*---------------------------------------------------------------------*)
  543.  
  544. {$IFDEF DUMP_FREE}
  545.  
  546.       #$18: BEGIN;
  547.               dump_reason('ALT-O processing dump free');
  548.               dump_all;
  549.             END;
  550.  
  551. {$ENDIF}
  552.  
  553.       (*---------------------------------------------------------------------*)
  554.       (* Action list debugger -- ALT-O                                       *)
  555.       (*---------------------------------------------------------------------*)
  556.  
  557. {$IFDEF DUMP_SEARCH}
  558.  
  559.       #$18: BEGIN;
  560.               dump_reason('ALT-O processing dump action');
  561.               dump_action_all;
  562.             END;
  563.  
  564. {$ENDIF}
  565.  
  566.       (*---------------------------------------------------------------------*)
  567.       (* Node debugger -- ALT-U                                              *)
  568.       (*---------------------------------------------------------------------*)
  569.  
  570. {$IFDEF NODEBUG}
  571.  
  572.       #$16: BEGIN;
  573.               dump_reason('ALT-P Node debugging');
  574.  
  575.               bug_port := ring_port;
  576.  
  577.               REPEAT
  578.  
  579.                 IF bug_port^.port_type = port_g8bpq THEN
  580.                   BEGIN;
  581.  
  582.                     FOR i := 1 TO bug_port^.max_chan DO
  583.                       BEGIN;
  584.  
  585.                         bug_tcb := bug_port^.connected^[i];
  586.  
  587.                         IF bug_tcb <> NIL THEN
  588.                           BEGIN;
  589.  
  590.                             bug_chn := bug_tcb^.tnc_in_chn;
  591.                             WHILE bug_chn <> NIL DO
  592.                               BEGIN;
  593.                                 WRITELN('Port ', bug_port^.port_char,
  594.                                         ' -- tcb ', bug_tcb^.port_chan_s,
  595.                                         ' -- chan ', bug_chn^.str_m_chan,
  596.                                         ' -- type ', bug_chn^.str_m_type,
  597.                                         ' -- ',
  598.                                     COPY(bug_chn^.str_m_data.str_data, 1, 15));
  599.                                 bug_chn := bug_chn^.str_m_next;
  600.                               END;
  601.  
  602.                           END;
  603.  
  604.                       END;
  605.  
  606.                   END;
  607.  
  608.                 bug_port := bug_port^.next_port;
  609.  
  610.               UNTIL bug_port = ring_port
  611.  
  612.             END;
  613.  
  614. {$ENDIF}
  615.  
  616.       (*---------------------------------------------------------------------*)
  617.       (* Window debugger -- ALT-Y                                            *)
  618.       (*---------------------------------------------------------------------*)
  619.  
  620. {$IFDEF WINBUG}
  621.  
  622.       #$15: dump_window_all;
  623.  
  624. {$ENDIF}
  625.  
  626.       (*---------------------------------------------------------------------*)
  627.       (* Port debugger -- ALT-Y                                              *)
  628.       (*---------------------------------------------------------------------*)
  629.  
  630. {$IFDEF PORTBUG}
  631.  
  632.       #$15: dump_all_thread;
  633.  
  634. {$ENDIF}
  635.  
  636.       (*---------------------------------------------------------------------*)
  637.       (* Unknown -- Beep!                                                    *)
  638.       (*---------------------------------------------------------------------*)
  639.  
  640.       ELSE
  641.         BEGIN;
  642.           status_window_change := TRUE;
  643.           SOUND(440);
  644.           DELAY(100);
  645.           NOSOUND;
  646.         END;
  647.  
  648.     END;
  649.  
  650.   END;
  651.  
  652. (*===========================================================================*)
  653. (* Make operator session go by by                                            *)
  654. (*===========================================================================*)
  655.  
  656. PROCEDURE close_operator_session;
  657.  
  658.   BEGIN;
  659.  
  660.     active_tcb^.uid_data.user_last   := current_day_time;
  661.     IF active_tcb^.last_l_time > active_tcb^.uid_data.user_l_time THEN
  662.       active_tcb^.uid_data.user_l_time := active_tcb^.last_l_time;
  663.  
  664.     update_uid(@active_tcb^.uid_data);
  665.  
  666.     operator_line_c := TRUE;
  667.     op_busy         := FALSE;
  668.  
  669.     window_deactivate(window_operator);
  670.     opr_window_open := FALSE;
  671.  
  672.     free_task_mem_all(active_tcb);
  673.  
  674.   END;
  675.  
  676. (*===========================================================================*)
  677. (* Initialization                                                            *)
  678. (*===========================================================================*)
  679.  
  680. PROCEDURE operator_init_session;
  681.  
  682.   BEGIN;
  683.  
  684.     operator_insert := FALSE;
  685.     current_buffer  := 0;
  686.     high_buffer     := 0;
  687.     insert_buffer   := 0;
  688.  
  689.   END;
  690.  
  691. END.
  692.